home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / basic / vudu3p.zip / VUDEMO.BAS < prev    next >
BASIC Source File  |  1992-06-07  |  21KB  |  684 lines

  1. '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  2. '*             VUDEMO.BAS - VUDU Windows Demonstration Program               *
  3. '*                                                                           *
  4. '*                               Binary Systems                              *
  5. '*                               PO BOX 10714                                *
  6. '*                               FARGO, ND  58106                            *
  7. '*                               (701) 281-2732                              *
  8. '*                                                                           *
  9. '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  10.  
  11. '$INCLUDE: 'VUDU.INC'
  12.  
  13. DECLARE SUB datedemo ()
  14. DECLARE SUB overview ()
  15. DECLARE SUB printdemo ()
  16. DECLARE SUB randomtest ()
  17. DECLARE SUB randscroll ()
  18. DECLARE SUB windowdemo ()
  19. DECLARE SUB windows ()
  20. DECLARE SUB infielddemo ()
  21. DECLARE SUB messagedemo ()
  22. DECLARE SUB scrolldemo ()
  23. DECLARE SUB bardemo ()
  24. DECLARE SUB begin ()
  25.  
  26.  
  27. DEFINT A-Z
  28. CONST HEADLINE = "VUDU Windows Version 3.01 for QuickBASIC and PDS 7 ∙ Demo Program"
  29. DIM SHARED background AS STRING
  30. DIM lin(1 TO 3) AS STRING
  31.  
  32. ' Attributes For Window Interactive Demo
  33. DIM SHARED oldrow   AS INTEGER, oldcol   AS INTEGER
  34. DIM SHARED oldwfg   AS INTEGER, oldwbg   AS INTEGER
  35. DIM SHARED oldhedfg AS INTEGER, oldhedbg AS INTEGER
  36. DIM SHARED oldshad  AS INTEGER, oldedge  AS INTEGER
  37.  
  38. ' Type For INFIELD Specifications
  39. TYPE fieldtype
  40.      row AS INTEGER
  41.      Col AS INTEGER
  42.      lng AS INTEGER
  43. END TYPE
  44.  
  45. 'Main Proc
  46.     VINIT   ' call VINIT before executing any VUDU statements
  47.        
  48.     ' Setting the default values for the 'stretchy box' demo
  49.     oldrow = 22: oldcol = 76
  50.     oldhedfg = 15: oldhedbg = 1
  51.     oldwfg = 15: oldwbg = 1
  52.     oldshad = NO: oldedge = 2
  53.  
  54.     FirstLet = CM(YEL + BRITE, WHT + BRITE + FLASH)
  55.     LabelPos = RIGHT
  56.    
  57.     LOCATE , , 0                    'Cursor off
  58.     SCREEN 0: WIDTH 80, 25          '25x80 text mode
  59.   
  60.     ' This is the whole program?
  61.     SAVSCREEN scr$
  62.     begin
  63.     RESCREEN scr$
  64.  
  65.     lin(1) = "    For ordering information, type out the file 'README'"
  66.     lin(2) = " Thank you for viewing VUDU Window Demo by Binary Systems."
  67.     lin(3) = "              Good night and drive safely."
  68.     DEFWIN 0, 0, 0, 3, 0, 3, THIN, YES
  69.     a$ = MESSAGE(r, c, "", lin(), "", 10, YES)
  70.  
  71.     PRINTS SPACE$(80), 25, 1, 0
  72.     LOCATE 25, 1, 1
  73.  
  74. END
  75.  
  76.  
  77.  
  78. ' DATADATADATA - I Like To Keep My DATA Down Out Of The Way - DATADATADATA
  79.  
  80. menudata:
  81. DATA Windows Overview, Windows Demonstration
  82. DATA Barmenu Function Demo, ScrollMenu Function Demo
  83. DATA Message Function Demo, Infield Function Demo, DatIn Demo
  84. DATA Print Routines
  85. DATA Random Pattern Generator,Random Scroll,Exit To Dos
  86.  
  87.  
  88. barmenudata:
  89. DATA Parameters
  90. DATA The barmenu function  accepts two arrays
  91. DATA as  parameters.  The first  contains the
  92. DATA heading  names that  will  appear  above
  93. DATA their  respective menu.  The second is a
  94. DATA two dimensional  array  to  contain  the
  95. DATA lists of items which  appear under their
  96. DATA respective headings.,,,,,,,,,,,,,,
  97.  
  98. DATA Headings
  99. DATA You may pass as many menu  headings
  100. DATA as  you can  fit on  the  menu bar.
  101. DATA you may  also pass  up to  22 items
  102. DATA for each heading without shadows or
  103. DATA 21  if you prefer shadows.  Barmenu
  104. DATA returns  the  subscript  chosen and
  105. DATA key  the  user  entered to  escape.,,,,,,,,,,,,,,
  106.  
  107. DATA Sizing
  108. DATA The function automatically sizes
  109. DATA everthing for you.  The  headers
  110. DATA are spaced and the widths of the
  111. DATA windows are set according to the
  112. DATA widest item element.  The header
  113. DATA bar filler character is variable
  114. DATA to suit different styles.,,,,,,,,,,,,,,
  115.  
  116. DATA Auto-adjust
  117. DATA If you like your menu choices to be  extremely descriptive -
  118. DATA no problem!  The bar menu function will automatically adjust
  119. DATA your sub-menu to fit asthetically under the menu label.   So
  120. DATA use the whole screen if you wish!  Hit ESC or ENTER for menu.
  121. DATA Line 5
  122. DATA Line 6
  123. DATA Line 7
  124. DATA Line 8
  125. DATA Line 9
  126. DATA Line 10
  127. DATA Line 11
  128. DATA Line 12
  129. DATA Line 13
  130. DATA Line 14
  131. DATA Line 15
  132. DATA Line 16
  133. DATA Line 17
  134. DATA Line 18
  135. DATA Line 19
  136. DATA Line 20
  137. DATA Line 21
  138.  
  139. scrolldata:
  140. DATA The scrollmenu function allows the user to choose from a list
  141. DATA of items which would not normally fit within the boundaries
  142. DATA of a window.  The list may be as long as needed and the window
  143. DATA may be as short as needed (minimum of one line).
  144. DATA "                                                        MORE "
  145. DATA "     Scrolling of one full window length is done with the PgUp"
  146. DATA and PgDn keys.  the up and down cursor keys allow moving one
  147. DATA line at a time.
  148. DATA " "
  149. DATA "     The following is a demonstration of choosing an item from"
  150. DATA the scrollmenu list.            Press <ENTER> to continue
  151.  
  152. fielddata:
  153. DATA 14,13,17, 14,36,10, 14,52,17
  154. DATA 16,13,17, 16,36,10, 16,52,17
  155.  
  156. SUB bardemo
  157.    DIM headers(1 TO 4) AS STRING
  158.    DIM Items(1 TO 4, 1 TO 21) AS STRING
  159.    DIM scr AS STRING, retrn  AS STRING
  160.  
  161.    RESTORE barmenudata
  162.    FOR x = 1 TO 4
  163.        READ headers(x)
  164.        FOR y = 1 TO 21
  165.        READ Items(x, y)
  166.        NEXT y
  167.    NEXT x
  168.    
  169.    RESCREEN background
  170.  
  171.    DEFWIN 0, 0, 15, 3, 0, 3, THIN, YES
  172.    DEFBAR 0, 7, 205, NO
  173.  
  174.    baron = NO
  175.    retrn = BARMENU(headers(), Items(), m, i)
  176.    SELECT CASE retrn
  177.      CASE ESC: retrn = "n escape keypress"
  178.      CASE CR: retrn = " carriage return"
  179.    END SELECT
  180.  
  181.    DIM Msg(1 TO 1) AS STRING
  182.    Msg(1) = "You exited with a" + retrn
  183.    Msg(1) = Msg(1) + " and chose menu" + STR$(m) + ", item" + STR$(i) + "."
  184.    DEFWIN 15, 0, 15, 4, 14, 4, THIN, YES
  185.    Msg(1) = MESSAGE(14, c, "Message Box", Msg(), "", 5, YES)
  186.    
  187. END SUB
  188.  
  189. SUB begin
  190.     DIM win AS STRING, bar AS STRING, raise AS STRING
  191.     DIM fg AS INTEGER, bg AS INTEGER
  192.     DIM lin(1 TO 12) AS STRING
  193.     DIM clr AS STRING, vid AS STRING
  194.  
  195.     'Create Opening Screen
  196.     DEFWIN 0, 0, 7, 1, 7, 1, NONE, NO
  197.     OPENWIN 1, 1, 25, 80, ""
  198.    
  199.     'Lightning!
  200.     w$ = STRING$(15, 219)
  201.     var = 56
  202.     FOR x = 1 TO 25
  203.        IF x MOD 7 = 0 THEN var = var + 10
  204.        IF x > 21 THEN w$ = LEFT$(w$, LEN(w$) - 3)
  205.        IF x = 25 THEN var = var + 1
  206.        IF x < 25 THEN HILITE x + 1, var - x * 3 + 1, LEN(w$), 8
  207.        PRINTS w$, x, var - x * 3, CM(14, 7)
  208.     NEXT x
  209.    
  210.     'Print Bottom Bar Labels
  211.     PRINTS SPACE$(80), 1, 1, ATTRIB(WHT + BRITE, MAG)
  212.     PRINTS HEADLINE, 1, 40 - LEN(HEADLINE) / 2, 0
  213.    
  214.  
  215.     'laser sound effect
  216.      PLAY "mf"
  217.      FOR x = 10000 TO 37 STEP -100
  218.      SOUND x \ 2, .03
  219.      SOUND x, .07
  220.      NEXT x
  221.  
  222.     ' ***********************  FIRST WINDOW  ***************************
  223.     lin(1) = "  V U D U   W I N D O W S   Version 3.01  By Binary Systems"
  224.     lin(2) = "    User interface and display tools for Microsoft BASICs"
  225.     lin(3) = " "
  226.     lin(4) = "       Press Any Key For The Demonstration Program "
  227.     
  228.     DEFWIN 15, 4, 15, 4, 14, 4, PAIR, YES
  229.     w$ = MESSAGE(r, c, "", lin(), "", 300, YES)
  230.  
  231.  
  232.     ' **********************  SECOND MESSAGE  ***************************
  233.     'message window describing VUDU
  234.     lin(1) = "VUDU (Very Useful Display Utilities) features:"
  235.     lin(2) = "      Built in mouse support and mouse procedures"
  236.     lin(3) = "      Automatic sensing of the active video page"
  237.     lin(4) = "      Automatic sensing of monochrome/color card"
  238.     lin(5) = "      Optional auto-centering for all windows"
  239.     lin(6) = "      Auto snow elimination on CGA systems"
  240.     lin(7) = "      Easy customization"
  241.     DEFWIN 15, 4, 15, 4, 14, 4, PAIR, YES
  242.     a$ = MESSAGE(0, 0, "The VUDU Windows", lin(), "", 15, YES)
  243.    
  244.    
  245.     ' Print VIDEO INFORMATION
  246.     REDIM lin(1 TO 12) AS STRING
  247.     SELECT CASE VIDCARD
  248.      CASE MONO: lin(1) = "MonoChrome"
  249.      CASE CGA:  lin(1) = "CGA"
  250.      CASE EGA:  lin(1) = "EGA"
  251.      CASE VGA:  lin(1) = "VGA"
  252.     END SELECT
  253.     lin(1) = lin(1) + " Video Card Detected"
  254.     IF Vmouse THEN
  255.        lin(2) = "Mouse is active"
  256.     ELSE
  257.        lin(2) = "Mouse not installed"
  258.     END IF
  259.     DEFWIN 0, 0, YEL + BRITE, 0, WHT + BRITE, 0, THIN, YES
  260.     a$ = MESSAGE(19, 42, "", lin(), "", 0, NO)
  261.   
  262.     ' Read Menu Data
  263.     RESTORE menudata
  264.     FOR x = 1 TO 11
  265.        READ lin(x)
  266.     NEXT x
  267.    
  268.  
  269.   ' Begin the Menu Loop
  270.   DO
  271.    
  272.     'DISPLAY MENU
  273.     LabelPos = LEFT
  274.     DEFWIN WHT + BRITE, 0, YEL + BRITE, 0, WHT + BRITE, 0, THIN, YES
  275.     a$ = MAKEMENU(3, 3, NO, "VUDU", lin(), selection)
  276.     SAVSCREEN background
  277.  
  278.     IF a$ <> ESC THEN
  279.       SELECT CASE selection
  280.        CASE 1: overview
  281.        CASE 2: windowdemo
  282.        CASE 3: bardemo
  283.        CASE 4: scrolldemo
  284.        CASE 5: messagedemo
  285.        CASE 6: infielddemo
  286.        CASE 7: datedemo
  287.        CASE 8: printdemo
  288.        CASE 9: randomtest
  289.        CASE 10: randscroll
  290.       END SELECT
  291.     END IF
  292.     RESCREEN background
  293.  
  294.    LOOP UNTIL a$ = ESC OR selection = 11
  295.  
  296. END SUB
  297.  
  298. SUB datedemo
  299.     DIM lin(1 TO 4) AS STRING
  300.    
  301.     lin(1) = "MMDDYY"
  302.     lin(2) = "MMDDYYYY"
  303.     lin(3) = "YYMMDD"
  304.     lin(4) = "DDMMYY (Euro)"
  305.    
  306.     LabelPos = CENTER
  307.     DEFWIN WHT + BRITE, RED, WHT + BRITE, RED, BLK, RED, THIN, YES
  308.     a$ = MAKEMENU(3, 50, NO, "Datin", lin(), selection)
  309.     IF a$ = ESC THEN EXIT SUB
  310.  
  311.     REDIM lin(1 TO 1) AS STRING
  312.     lin(1) = "Input:             Returned:          "
  313.     a$ = MESSAGE(0, 0, "DATIN Function Demo", lin(), "", 0, NO)
  314.     LOCATE 13, 30: VCOLOR YEL + BRITE, BLK
  315.     a$ = DATIN(selection - 1)
  316.     IF (a$ <> ESC) THEN
  317.        PRINTS a$, 13, 51, 0
  318.        VSLEEP 3
  319.     END IF
  320. END SUB
  321.  
  322. SUB infielddemo
  323.     DIM lin(1 TO 13) AS STRING
  324.     DIM fld(1 TO 6) AS fieldtype
  325.     DIM retrn AS STRING
  326.  
  327.     RESCREEN background
  328.     LabelPos = CENTER
  329.  
  330.     lin(1) = "The  InField  function does  just as its name implies; it"
  331.     lin(2) = "allows  user input  within a  specifically  defined field"
  332.     lin(3) = "of the screen.  A powerful alternative to INPUT$, InField"
  333.     lin(4) = "gives  the  programmer  full  control of the screen while"
  334.     lin(5) = "allowing  the user full  control of the cursor.  Here are"
  335.     lin(6) = "some keys you may want to try in the demo fields:"
  336.     lin(7) = " "
  337.     lin(8) = "Enter, Home, End, Ins, Del, Back Space, Tab, Shift+Tab."
  338.     lin(9) = "Press the Esc key to end this part of the demo."
  339.     lin(10) = " ": lin(11) = " ": lin(12) = " ": lin(13) = " "
  340.     DEFWIN 15, 0, CM(4, 7), 0, 15, 0, ILINE, YES
  341.     a$ = MESSAGE(2, c, "Message Boxes", lin(), "", 0, NO)
  342.  
  343.     'read in data for fields and hilite
  344.     RESTORE fielddata
  345.     VCOLOR CM(14, 0), CM(4, 7)          ' Set global color
  346.     FOR x = 1 TO 6
  347.     READ fld(x).row
  348.     READ fld(x).Col
  349.     READ fld(x).lng
  350.     HILITE fld(x).row, fld(x).Col, fld(x).lng, 30
  351.     NEXT x
  352.     lin(1) = SPACE$(35): lin(2) = ""
  353.    
  354.     'print returned values window
  355.     c = 0
  356.     a$ = MESSAGE(19, c, "Returned values", lin(), "", 0, NO)
  357.     PRINTS "Text Returned: ", 21, 25, CM(4, 7)
  358.  
  359.     x = 1
  360.     DO
  361.       LOCATE fld(x).row, fld(x).Col
  362.       retrn = INFIELD(text$, fld(x).lng)
  363.       IF retrn <> ESC THEN
  364.      PRINTS SPACE$(17), 21, 41, 0
  365.      PRINTS text$, 21, 41, 0 'CM(14,7)
  366.       END IF
  367.       IF x = UBOUND(fld) THEN x = 1 ELSE x = x + 1
  368.     LOOP WHILE retrn <> ESC
  369.     LOCATE , , 0
  370. END SUB
  371.  
  372. SUB messagedemo
  373.     DIM lin(1 TO 6)  AS STRING
  374.    
  375.     DEFWIN 0, 0, 0, BLU, 0, BLU, NONE, NO
  376.     OPENWIN 2, 1, 25, 80, ""
  377.    
  378.     LabelPos = LEFT
  379.     DEFWIN 15, 0, 4, 0, 15, 0, ILINE, YES
  380.    
  381.     lin(1) = "The Message Box  is a multi-purpose display utility."
  382.     lin(2) = "With it  you can create  dialog boxes which   simply"
  383.     lin(3) = "display a message to the user for a specified period"
  384.     lin(4) = "of time or until a key is pressed.  This window will"
  385.     lin(5) = "be active for 15 seconds before continuing..."
  386.    
  387.     a$ = MESSAGE(11, 3, "Message Boxes", lin(), "", 15, NO)
  388.     IF a$ = ESC THEN EXIT SUB
  389.  
  390.     lin(1) = "You  may also choose  to create messages  which  require"
  391.     lin(2) = "input  from  the  user  before   continuing.   You  pass"
  392.     lin(3) = "the  possible   keystrokes  to  the   function   and  it"
  393.     lin(4) = "will  display the  message  you  specify  and  await one"
  394.     lin(5) = "of your keystrokes, returning it when it is encountered."
  395.     lin(6) = "For instance, press either 'Q' or 'Z' now..."
  396.     a$ = MESSAGE(7, 8, "Message Boxes", lin(), "QZ", 5, NO)
  397.     IF a$ = ESC THEN EXIT SUB
  398.  
  399. '   IF A$ <> "" THEN
  400.       lin(1) = "Good, I see you found " + a$ + ".  The Message function is a power-"
  401.       lin(2) = "ful addition to any program requiring user choices.    The"
  402.       lin(3) = "Message function's capabilities  are nicely  enhanced when "
  403.       lin(4) = "used  in  conjunction  with  the  INFIELD  procedure."
  404.       lin(5) = ""
  405.       lin(6) = ""
  406.       a$ = MESSAGE(4, 13, "Message Boxes", lin(), CHR$(13), 5, NO)
  407.  '  END IF
  408.    
  409.     RESCREEN scr$
  410. END SUB
  411.  
  412. SUB overview
  413. DIM head(1 TO 6) AS STRING
  414. DIM Msg(1 TO 7) AS STRING, Choice  AS STRING, ret AS STRING
  415. DIM colors(0 TO 4) AS INTEGER
  416.  
  417. colors(0) = 6
  418. colors(1) = 2
  419. colors(2) = 1
  420. colors(3) = 5
  421. colors(4) = 3
  422.  
  423. head(1) = "NONE"
  424. head(2) = "THIN"
  425. head(3) = "PAIR"
  426. head(4) = "ILINE"
  427. head(5) = "HLINE"
  428. head(6) = "THICK"
  429.  
  430. RESCREEN background
  431. FOR x = 0 TO 4
  432.     LabelPos = 4 - x
  433.     DEFWIN 15, colors(x), 15, colors(x), 15, colors(x), x + 1, YES
  434.     OPENWIN 3 + x * 2, 47 - x * 8, 11 + x * 2, 75 - x, head(x + 1)
  435. NEXT x
  436.  
  437. Msg(1) = "Windows may be  defined  as  having the  shown  border "
  438. Msg(2) = "attributes.   VUDU  supports all  colors in color text"
  439. Msg(3) = "mode including  blinking  attributes.   Other features"
  440. Msg(4) = "are  automatic  horizontal  and  vertical  positioning"
  441. Msg(5) = "and optional transparent shadows.  Labels may be  pos-"
  442. Msg(6) = "itioned  centered, right or left  offset on the  upper"
  443. Msg(7) = "border of the window."
  444.  
  445. DEFWIN 15, 4, 15, 4, 15, 4, THICK, YES
  446. ret = MESSAGE(13, 11, head(6), Msg(), Choice, 20, YES)
  447. IF ret = ESC THEN EXIT SUB
  448.  
  449. Msg(1) = "If your  programs  utilize the video paging feature of "
  450. Msg(2) = "the color video cards,  VUDU will write  to the active"
  451. Msg(3) = "video page.  This allows  writing  to one  page  while"
  452. Msg(4) = "viewing  another.  VUDU also automatically  determines"
  453. Msg(5) = "the  installed   video  card  and  will  perform  snow"
  454. Msg(6) = "checking if a CGA card is found."
  455. Msg(7) = ""
  456.  
  457. DEFWIN 15, 2, 15, 2, 15, 2, THICK, YES
  458. LabelPos = RIGHT
  459. ret = MESSAGE(13, 11, head(6), Msg(), Choice, 20, NO)
  460. END SUB
  461.  
  462. SUB printdemo
  463.     DIM lines(1 TO 10) AS STRING, rtn  AS STRING, StrVar AS STRING
  464.     DIM row AS INTEGER, Col AS INTEGER
  465.  
  466.     FOR x = 5 TO 10: lines(x) = " ": NEXT x 'Give spaces
  467.     lines(1) = "Syntax: PRINTS StrVar$, row%, col%, ColorAttribute%"
  468.     lines(2) = "        PRINTV StrVar$, row%, col%, ColorAttribute%"
  469.     lines(3) = " "
  470.     lines(4) = "PRINTS displays a string in the horizontal position"
  471.     LabelPos = CENTER
  472.     DEFWIN 15, 4, 15, 4, 15, 4, THIN, YES
  473.    
  474.    
  475.     rtn = MESSAGE(r, Col, "PRINTS/PRINTV", lines(), "", 0, NO)
  476.     BRIDGE 12, Col, 68, 0
  477.    
  478.     Col = Col + 5
  479.     FOR x = 1 TO 6
  480.        st$ = st$ + " Prints "
  481.        PRINTS st$, 12 + x, Col, x
  482.     NEXT x
  483.     VSLEEP 5
  484.   
  485.     Col = Col - 2
  486.     PRINTS "PRINTV displays a string in the vertical position  ", 11, Col, 0
  487.  
  488.     FOR x = 1 TO 49
  489.        PRINTV "PRINTV", 13, Col + x, x
  490.     NEXT x
  491.     VSLEEP 5
  492.  
  493. END SUB
  494.  
  495. SUB randomtest
  496. position = 2
  497. counter = 100
  498. DO
  499.     IF (counter = 100) THEN
  500.        counter = 0
  501.        PRINTS SPACE$(80), 25, 1, 63
  502.        PRINTS "Esc for menu", 25, position, 0
  503.        position = position + 1
  504.        IF (position = 69) THEN position = 2
  505.     END IF
  506.     counter = counter + 1
  507.        
  508.     ulr = RND * 17: WHILE ulr < 1: ulr = RND * 17: WEND
  509.     lrr = RND * 24: WHILE lrr < ulr + 2: lrr = RND * 24: WEND
  510.     ulc = RND * 60: WHILE ulc < 1: ulc = RND * 60: WEND
  511.     lrc = RND * 79: WHILE lrc < ulc + 2: lrc = RND * 79: WEND
  512.     fore = RND * 15: back = RND * 7
  513.     DEFWIN 0, 0, fore + INT(RND * 2) * 16, back, fore, back, INT(RND * 6 + 1), (INT(RND * 2) - 1) * ((lrr < 24) * -1)
  514.     OPENWIN ulr, ulc, lrr, lrc, ""
  515. LOOP WHILE (CLICK <> ESC)
  516. randscroll
  517. END SUB
  518.  
  519. SUB randscroll
  520.     direction = INT(RND * 4)
  521.     ScrollAttrib = CM(1, 7)
  522.  
  523.     IF direction > RIGHT THEN
  524.        reps = 25
  525.     ELSE
  526.        reps = 80
  527.     END IF
  528.  
  529.     FOR x = 1 TO reps
  530.       SCROLL 1, 1, 25, 80, direction
  531.     NEXT x
  532. END SUB
  533.  
  534. SUB scrolldemo
  535.     DIM win AS STRING
  536.     DIM Items(1 TO 25)  AS STRING
  537.     DIM tem(1 TO 1) AS STRING
  538.     DIM Choice AS INTEGER, row AS INTEGER, Col AS INTEGER
  539.    
  540.     RESTORE scrolldata
  541.     FOR x = 1 TO 11
  542.     READ Items(x)
  543.     NEXT x
  544.    
  545.     DEFWIN 1, 3, 1, 3, 1, 3, PAIR, YES
  546.     IF SCROLLMENU(0, 0, 5, YES, Items(), "The ScrollMenu Function", Choice) = ESC THEN
  547.        EXIT SUB
  548.     END IF
  549.  
  550.     FOR x = 1 TO 25
  551.     Items(x) = "  Item Number " + STR$(x) + "  "
  552.     NEXT x
  553.  
  554.     'pick an item scroll menu
  555.     DEFWIN 14, 0, 14, 0, 15, 0, ILINE, YES
  556.     IF SCROLLMENU(0, 0, 5, YES, Items(), "Scroll Choices", Choice) = ESC THEN
  557.        EXIT SUB
  558.     END IF
  559.  
  560.     tem(1) = "You Chose " + LTRIM$(RTRIM$(Items(Choice)))
  561.    
  562.     DEFWIN 14, 4, 14, 4, 14, 4, HLINE, YES
  563.     a$ = MESSAGE(row, Col, "Result", tem(), "", 3, YES)
  564.  
  565. END SUB
  566.  
  567. SUB windowdemo
  568.   DIM in AS STRING
  569.  
  570.   LabelPos = LEFT
  571.   DEFWIN 15, 4, CM(15, 0), CM(1, 7), CM(15, 0), CM(1, 7), THIN, NO
  572.   OPENWIN 1, 1, 25, 80, "VUDU Window Interactive Demonstration"
  573.  
  574.   'Print Prompts
  575.   PRINTS "Press:", 3, 5, 30
  576.   PRINTS "<H> To Change Header Color", 5, 5, 30
  577.   PRINTS "<F> To Change Foreground Color", 7, 5, 30
  578.   PRINTS "<B> To Change Background Color", 9, 5, 30
  579.   PRINTS "<A> To Change Border Attribute", 11, 5, 30
  580.   PRINTS "<S> To Toggle Shadows", 13, 5, 30
  581.   PRINTS "<> To Shrink Length", 15, 5, 30
  582.   PRINTS "<> To Expand Length", 17, 5, 30
  583.   PRINTS "<> To Shrink Width", 19, 5, 30
  584.   PRINTS "<" + CHR$(26) + "> To Expand Width", 21, 5, 30
  585.   PRINTS "<Esc> Return To Menu", 23, 5, 30
  586.  
  587.   LabelPos = CENTER
  588.  
  589.   endcol = oldcol: endrow = oldrow
  590.   wfg = oldwfg: wbg = oldwbg
  591.   HedFG = oldhedfg: HedBG = oldhedbg
  592.   edge = oldedge
  593.   shad = oldshad
  594.   winflag = TRUE
  595.  
  596.   DO
  597.  
  598.     IF endrow < oldrow THEN
  599.        PRINTS SPACE$(38), oldrow, 40, 16
  600.        IF oldshad THEN HILITE oldrow + 1, 42, 38, 16
  601.     END IF
  602.    
  603.     IF endcol < oldcol THEN
  604.        PRINTV SPACE$(oldrow - 2), 3, oldcol, 16
  605.        IF shad THEN
  606.      HILITV 4, oldcol + 2, 20, 16
  607.        END IF
  608.     END IF
  609.  
  610.     'Remove old shadow
  611.     IF shad <> oldshad AND shad = NO THEN
  612.       HILITE endrow + 1, 42, 38, 16
  613.       HILITV 4, endcol + 1, 20, 16
  614.       HILITV 4, endcol + 2, 20, 16
  615.       winflag = NO
  616.     END IF
  617.  
  618.     oldwfg = wfg: oldwbg = wbg
  619.     oldhedfg = HedFG: oldhedbg = HedBG
  620.    
  621.     DEFWIN HedFG, HedBG, wfg, wbg, wfg, wbg, edge, shad
  622.     IF winflag THEN OPENWIN 3, 40, endrow, endcol, "demo"
  623.    
  624.     oldcol = endcol: oldrow = endrow
  625.     wfg = oldwfg: wbg = oldwbg
  626.     HedFG = oldhedfg: HedBG = oldhedbg
  627.     oldedge = edge
  628.     oldshad = shad
  629.     winflag = YES
  630.  
  631.     'Process Users Key
  632.     IF Vmouse THEN
  633.        oldr = 13: oldc = 40
  634.        SETMOUSE oldr, oldc
  635.        DO
  636.       in = CLICK
  637.       IF (in = "") THEN
  638.          MOUSEXY mr, mc
  639.          IF (mr > oldr) THEN in = DnKey
  640.          IF (mr < oldr) THEN in = UpKey
  641.          IF (mc > oldc + 5) THEN in = RKey
  642.          IF (mc < oldc - 5) THEN in = LKey
  643.          IF (mr = 1) OR (mr = 25) OR (mc = 1) OR (mc = 80) THEN
  644.         SETMOUSE 13, 40: oldr = 13: oldc = 40: in = ""
  645.          END IF
  646.       END IF
  647.        LOOP WHILE (in = "")
  648.        oldr = mr: oldc = mc
  649.     ELSE
  650.        in = GETCH
  651.     END IF
  652.     in = UCASE$(in)
  653.  
  654.     SELECT CASE in
  655.        CASE UpKey: endrow = endrow - 1             'Up Arrow
  656.          IF endrow < 5 THEN endrow = 5
  657.        CASE DnKey: endrow = endrow + 1             'Down Arrow
  658.          IF endrow > 22 THEN endrow = 22
  659.        CASE RKey: endcol = endcol + 1              'Right Arrow
  660.          IF endcol > 76 THEN endcol = 76
  661.        CASE LKey: endcol = endcol - 1              'Left Arrow
  662.          IF endcol < 53 THEN endcol = 53
  663.        CASE "H": HedFG = HedFG + 1
  664.          IF HedFG = 16 THEN
  665.            HedFG = 0: HedBG = HedBG + 1
  666.            IF HedBG = 8 THEN HedBG = 0
  667.          END IF
  668.        CASE "F": wfg = wfg + 1                    'Foreground Attrib
  669.          IF wfg > 15 THEN wfg = 0
  670.        CASE "B": wbg = wbg + 1                    'Background Attrib
  671.          IF wbg > 7 THEN wbg = 0
  672.        CASE "A": edge = edge + 1                  'Edge Attribute
  673.          IF edge > 6 THEN edge = 1
  674.        CASE "S": shad = NOT shad                  'Shadow Toggle
  675.        CASE ELSE: winflag = NO
  676.    END SELECT
  677.  
  678.   IF ATTRIB(wfg, wbg) = 0 THEN wfg = 1
  679.  
  680.   LOOP UNTIL in = ESC
  681.  
  682. END SUB
  683.  
  684.